open Fr
open FrMidi
open Printf

let print_note c n =
	let note_names =
		[| "C"; "C#"; "D"; "D#"; "E"; "F";
		   "F#"; "G"; "G#"; "A"; "A#"; "B" |] in
	fprintf c "%s%d" note_names.(n mod 12) (n / 12 - 2)

let print_voice_message c = function
	| `Note (action, note, velocity) ->
		fprintf c "Note %s %a = %u"
			(match action with
			| `On -> "on"
			| `Off -> "off"
			| `Aftertouch -> "aftertouch")
			print_note note
			velocity
	| `Control (control, value) ->
		fprintf c "Control %u = %u" control value
	| `Program program ->
		fprintf c "Program = %u" program
	| `Aftertouch value ->
		fprintf c "Aftertouch = %u" value
	| `PitchWheel value ->
		fprintf c "Pitch wheel = %d" value
	| _ ->
		fprintf c "other"

let print_message c = function
	| `Channel (ch, m) ->
		fprintf c "[Channel %u] %a" ch print_voice_message m
	| `System _ -> fprintf c "[System]"

let print_event c (d, m) =
	fprintf c "(%d) %a\n" d print_message m

let transpose n = function
	| `Channel (c, `Note (a, k, v)) -> `Channel (c, `Note (a, k + n, v))
	| m -> m

let copy_to c = function
	| `Channel (_, m) -> `Channel (c, m)
	| m -> m

let set_velocity v' = function
	| `Channel (c, `Note (a, k, v)) when v <> 0 ->
		`Channel (c, `Note (a, k, v'))
	| m -> m

let _ =
	let i = input default_input
	and output = lift (List.hd (List.tl @outputs)) in
	ignore (register_e (on i l -> List.iter (print_event stdout) l; flush stdout));
	ignore (connect_output output (map_m (set_velocity 96) i));
			(*(merge_m [map_m (transpose (-24)) (map_m (copy_to 2) i); i])
		);*)
	while true do Unix.sleep 1 done
